perm filename CONNEW.F4[EX2,LCS] blob
sn#153751 filedate 1975-07-17 generic text, type T, neo UTF8
00100 C *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314 *******
00200 C DEC 17,1970 ********* CONVERTS 18 (AND 12) BIT .DMD FILES ****
00300 C CONVERTS .DMD FILES WRITTEN WITH RCDFLG=1; OR BIGBIT=1;(or =2;)
00400 C LOAD WITH CVTIO.REL AND CVTALC.MAC
00500 C TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
00600 C 1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
00700 C 2ND IS ACTUAL NAME OF FILE.
00800 C IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
00900 C TO BACK UP TYPE '-1'. 'REWIND' MAY BE TYPED FOR 'MTA0?' OR 'NAME #1'.
01000 C USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
01100 DIMENSION JSB(128),IBOTT(4096)
01300 100 FORMAT(' TYPE NAME #1'/)
01400 200 FORMAT(' TYPE FINAL NAME'/)
01500 250 FORMAT(A1)
01600 300 FORMAT(2XA5,2XI7,I9)
01800 400 FORMAT(A5,2I)
01900 450 FORMAT(' READ FROM MTA0?'/)
02000 500 FORMAT(I,' WORDS, FACTOR=',F6.3,', MAXAMP=',I4/)
02100 600 FORMAT(' MORE??'/)
02200 700 FORMAT(' TYPE MAXAMP'/)
02300 800 FORMAT(4I)
02400 EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
02500 MUSIC='MUSIC'
03000 CC*** CALL PUTMUS(MUSIC)
03050 PUTM=-1
03100 FACTOR=1.
03300 N=9000
03400 JUDP=4
03500 C GARPLY READS 4*1024 WDS.
03600 JSIZE=1024
04300 101 KSIZE=JSIZE
04400 MX=0
04500 KCNT=0
04600 IX=0
04700 JA=1
04800 440 TYPE 450
04850 C ANSWERS: R=REWIND AND YES, A=ADVANCE TAPE AND LIST HIGHEST AMP.(SLOW!)
04875 C Y=YES, BLANK=NO
04900 ACCEPT 250,TAPE
04910 MAX=-1
04920 IF(TAPE.NE.'A')GO TO 441
04930 MAX=0
04940 ITOP=0
04950 GO TO 442
05000 441 IF(TAPE.NE.'R')GO TO 54
05100 REWIND 16
05200 442 TAPE='Y'
05300 54 TYPE 100
05400 JNM='AAAAA'
05500 ACCEPT 400,NAME,MAXAMP
05600 IF(MAXAMP.EQ.0)MAXAMP=MX
05700 IF(NAME.EQ.'-1')GO TO 440
05800 IF(NAME.EQ.'NO')GO TO 1201
05900 C CAN TYPE 'NO' IF MISTAKE ON 'MORE' EARLIER.
06000 IF(NAME.EQ.' ')NAME='MUSAA'
06100 2 JNM=JNM+((NAME-JNM)/256*256)
06200 KNM=JNM
06300 C AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
06400 1002 TYPE 200
06500 ACCEPT 400,NM2,KSKIP
06600 IF(NM2.EQ.'-1')GO TO 54
06700 IF(NM2.EQ.' ')NM2=NAME
06800 IF(TAPE.NE.'Y')GO TO 7077
06900 IF(MAXAMP.NE.0.OR.MAX.EQ.0)GO TO 2710
06910 C MAXAMP WAS GIVEN OR WE'RE LOOKING FOR IT.
07000 TYPE 700
07100 ACCEPT 800,MAXAMP
07200 IF(MAXAMP)GO TO 54
07210 C -1=BACKUP HERE
07300 IX=0
07400 2710 IF(NM2.EQ.' ')NM2=NAME
07500 1710 CALL GETTAP
07600 1810 CALL INTAPE(JSB(1),128)
07700 IF(JSB(1))GO TO 1202
07800 TYPE 300,JSB3
07900 IF(IX.OR.JSB2.EQ.3)GO TO 2022
08000 IF(MAXAMP.EQ.0)MAXAMP=2040
08100 GO TO 199
08200 7077 IF(MAXAMP.NE.0)GO TO 4022
08300 CALL GETFIL(NM2)
08400 CALL FASTIN(JSB(1),128)
08500 IF(JSB2.EQ.3)GO TO 4022
08600 JSC=JSB(1)
08700 6066 CALL FASTIN(IBOTT(1),JSC)
08800 IF(IBOTT(JSC).EQ.0)GO TO 6066
08900 MAXAMP=IABS(IBOTT(JSC))
09000 4022 IF(N)GO TO 710
09100 N=-2
09200 IF(JSB2.EQ.3)GO TO 710
09300 199 FACTOR=2040./MAXAMP
09400 MX=MAXAMP
09500 IX=-1
09600 KSIZE=3*JSIZE/2
09700 IF(TAPE.EQ.'Y')GO TO 2022
09800 C AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
09900 710 IF(TAPE.EQ.'Y')GO TO 1810
10000 CALL GETFIL(NAME)
10100 810 CALL FASTIN(JSB(1),128)
10200 IF(JSB2.EQ.3)IX=0
10300 2022 JSC=JSB(1)
10400 1022 IF(JA.GT.KSIZE)GO TO 17
10500 610 IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
10600 IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
10700 C LAST WORD IS THROWN AWAY.
10800 JA=JA+JSC-1
10900 JC=IBOTT(JA)
11000 IF(JC)5,1022,6
11100 5 JA=JA-IBOTT(JA-1)
11200 6 TYPE 300,NAME,JC,KCNT
11210 IF(JC)JC=-JC
11220 IF(JC.GT.ITOP)ITOP=JC
11230 C FINDS MAXAMP ON TAPE FILES.
11300 NAME=NAME+2
11400 IF(NAME.LE.JNM+50)GO TO 27
11500 JNM=JNM+256
11600 IF(JNM.LE.KNM+6400)GO TO 1017
11700 KNM=JNM+26112
11800 JNM=KNM
11900 C RAISES 'AAAZA' TO 'AABAA'
12000 1017 NAME=JNM
12100 27 IF(NAME.LE.NM2)GO TO 710
12110 1202 IF(MAX)GO TO 1203
12120 TYPE 500,KCNT,FACTOR,ITOP
12130 C TYPES MAXAMP OF TAPE FILES.
12140 GO TO 101
12150
12200 1203 TYPE 600
12300 ACCEPT 400,NAME
12400 IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
12500 1201 NM2=NAME-1
12600 17 JC=JA-1
12700 IF(JC.LT.KSIZE)GO TO 23
12800 10 IF(IX.AND.MAX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
12900 LSIZE=KSIZE
13000 JMP=-1
13100 32 KCNT=KCNT+JSIZE
13110 IF(PUTM)CALL PUTMUS(MUSIC)
13210 PUTM=0
13300 IF(MAX)CALL FSTMUS(IBOTT(1),JSIZE)
13400 IF(JMP)7,8,9
13700 7 JC=JC-LSIZE
13800 DO 12 K=1,JC
13900 12 IBOTT(K)=IBOTT(K+LSIZE)
14000 JA=JC+1
14100 IF(JC.GT.KSIZE)GO TO 10
14200 IF(NAME.LE.NM2)GO TO 610
14300 23 IF(IX.EQ.0)GO TO 43
14400 CALL NORM(IBOTT(1),JC,FACTOR)
14500 JC=JC*2/3
14550 43 IF(JC)JC=0
14575 C ****** WHY SHOULD IT EVER BE NEG. 7/74
14600 DO 13 K=JC+1,JSIZE
14700 13 IBOTT(K)=0
14800 JMP=0
14900 GO TO 32
15000 8 DO 14 K=1,JSIZE
15100 14 IBOTT(K)=0
15200 JMP=1
15300 GO TO 32
15400 9 K=KCNT/JSIZE
15500 L=K-(K/JUDP)*JUDP
15600 IF(L.EQ.0)GO TO 3222
15700 DO 4222 K=1,JSIZE
15800 4222 IBOTT(K)=0
15900 DO 6222 K=1,L
16300 6222 CALL FSTMUS(IBOTT(1),JSIZE)
16500 KCNT=KCNT+L*JSIZE
16600 3222 CALL FINMUS
16800 7222 TYPE 500,KCNT,FACTOR,MAXAMP
16900 END